home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / product.arc / PLDIST.LSP < prev    next >
Encoding:
Text File  |  1986-10-20  |  2.0 KB  |  43 lines
  1. ; ---------------------------------------------------------------------
  2. ;   PLDIST                               Kramer Consulting, Inc.
  3. ;                                        August 1986   W.Kramer
  4. ;   Polyline Distance Calculations.
  5. ;
  6. ;   User selects a polyline (or group of polylines) and the distance
  7. ;   is calculated for each polyline selected.
  8. ;   The polyline being calculated is "highlighted".
  9. ; ----------------------------------------------------------------------
  10. (defun c:pldist ()
  11.    (setvar "CMDECHO" 0)
  12.    (setq ss (ssget))
  13.    (setq sl (sslength ss))
  14.    (setq inx -1)
  15.    (repeat sl
  16.       (setq penam (ssname ss (setq inx (1+ inx)))) 
  17.       (setq elst (entget penam))
  18.       (cond ((= (cdr (assoc 0 elst)) "POLYLINE")
  19.               (redraw penam 3)
  20.               (setq enam (entnext (cdr (assoc -1 elst))))
  21.               (setq olst (entget enam))
  22.               (setq d 0.0)(setq p1 (cdr (assoc 10 olst)))
  23.               (setq enam (entnext (cdr (assoc -1 olst))))
  24.               (setq elst (entget enam))
  25.               (while (= (cdr (assoc 0 elst)) "VERTEX")
  26.                   (cond 
  27.                    ((zerop (cdr (assoc 42 olst))) 
  28.                      (setq d (+ d (distance p1 (cdr (assoc 10 elst))))))
  29.                    (t  
  30.                      (setq theta (* (atan (abs (cdr (assoc 42 olst)))) 4.0))
  31.                      (if (<= theta pi) 
  32.                         (setq phi (* 0.5 theta))
  33.                         (setq phi (* 0.5 (- (* 2.0 pi) theta))))
  34.                      (setq rad (/ (distance p1 (cdr (assoc 10 elst)))
  35.                                   (sin phi) 2.0)) 
  36.                      (setq d (+ d (* theta rad)))))
  37.                   (setq p1 (cdr (assoc 10 elst))) 
  38.                   (setq olst elst)
  39.                   (setq enam (entnext (cdr (assoc -1 elst))))
  40.                   (setq elst (entget enam)))
  41.               (prompt (strcat "\nPolyline distance:" (rtos d 2 5) "  ")) 
  42.               (redraw penam 4)))))
  43.